home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / opengl / glLight.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-22  |  6.9 KB  |  200 lines
  1. unit glLight;
  2.  
  3. interface
  4.   Uses windows,Classes,opengl, GLFuncs, GLWin;
  5.  
  6.  Type
  7.   TCustomGLLightWindow = class(TCustomOpenGLWindow)
  8.   // has all the lighting stuff
  9.     private
  10.   (*   procedure PaintWindow(DC: HDC); override;*)
  11.  
  12.     protected
  13.  //Structures for lighting
  14.     fLightingState,
  15.  // turns lighting on/off
  16.     fLocalViewer,
  17.  // turn on/off local viewer lighting calcs WARNING can be slow
  18.     fTwoSided           : Boolean;
  19.  //turn on/off two sided lighting WARNING can be slow
  20.     fGlobalAmbient      : tGLLightVal;
  21.  // background or global lighting value
  22.     fHeadLightState     : Boolean;
  23.  //light0 is a headlight and tracks the viewer position
  24.  // the current viewer will have a pointer to the headlight assigned
  25.  
  26. //Set up the global lighting values
  27.  
  28.     fLights : Array[0..7] of tGLLight;
  29.  
  30.     procedure DestroyWindowHandle;           Override;
  31.     // get rid of the light stuff
  32.     Procedure GLSessionSetUp;                Override;
  33.    {Set up when GL session is started}
  34.  
  35.    Procedure SetheadLightOn(Value:Boolean);
  36.    //turn on and off the headlight
  37.    Procedure SetLightingState(Value:Boolean);
  38.    //turn omn lighting and set global values
  39.    Procedure BuilsLightSetUpList;
  40.    Procedure SetGlobalAmbient(aVal: tGLLightVal);
  41.  
  42.    Public
  43.     constructor Create(AOwner: TComponent); Override;
  44.     destructor Destroy;                     override;
  45.  
  46.    Procedure BuildDisplayLists;              Override;
  47.    {This procedure builds all the standard display objects for the gl
  48.    session}
  49.     Procedure LightOn(aLightNum:SmallInt);
  50.     //turn designated light on
  51.     Procedure LightOff(aLightNum:SmallInt);
  52.     //turn designated light off
  53.     Function IsLightOn(aVal:SmallInt):Boolean;
  54.     //reuturn true if the specified light is on
  55.     Property HeadLightOn:Boolean Read fHeadLightState Write SetHeadLightOn;
  56.     Property LightingOn:Boolean Read fLightingState Write SetLightingState;
  57.     Property Ambient:tGLLightVal Read fGlobalAmbient write fGlobalAmbient;
  58.   end;
  59.  
  60. {procedure Register;}
  61. (*************************************************************)
  62. (*************************************************************)
  63.                         implementation
  64. (*************************************************************)
  65. constructor TCustomGLLightWindow.Create(AOwner: TComponent);
  66.  Var I:LongInt;
  67. Begin
  68.   Inherited Create(aOwner);
  69.   With fGlobalAmbient do
  70.    Begin
  71.     R:=0.0;G:=0.0;B:=0.0;A:=1.0//Default values
  72.    end;
  73.     fLightingState:=False;
  74.  // turns lighting on/off
  75.     fLocalViewer  :=False;
  76.  // turn on/off local viewer lighting calcs WARNING can be slow
  77.     fTwoSided     :=False;
  78.  
  79.     For I:=0 to 7 do fLights[I]:=tGLLight.Create($4000+i);
  80.   // set up the light values
  81.     fViewer.Headlight:=fLights[0];
  82.  
  83. end;
  84. (*************************************************************)
  85. Destructor TCustomGLLightWindow.Destroy;
  86. Var I:Smallint;
  87. Begin
  88.     For I:=0 to 7 do fLights[I].Free;
  89.     Inherited;
  90. end;
  91. (*************************************************************)
  92. Procedure TCustomGLLightWindow.SetGlobalAmbient(aVal: tGLLightVal);
  93.   Begin
  94.     If (fGlobalAmbient.R=aVal.R) and
  95.        (fGlobalAmbient.G=aVal.G) and
  96.        (fGlobalAmbient.B=aVal.B) and
  97.        (fGlobalAmbient.A=aVal.A) then exit;
  98.     fGlobalAmbient:=aVal;
  99.     BuilsLightSetUpList;
  100.     If fLightingState then glCallList(fGeneralLists+dlLightsOn);
  101.   end;
  102. (*************************************************************)
  103. procedure TCustomGLLightWindow.DestroyWindowHandle;
  104.  Begin
  105.   Inherited DestroyWindowHandle;
  106.  end;
  107. (*************************************************************)
  108.  Procedure TCustomGLLightWindow.GLSessionSetUp;
  109.    {Set up when GL session is started}
  110.    Begin
  111.      Inherited GLSessionSetUp;
  112.      If fHRC=0 then exit;
  113.      If fLightingState then glCalllist(fGeneralLists+ dlLightsOn);
  114.    end;
  115.  
  116. Procedure TCustomGLLightWindow.BuilsLightSetUpList;
  117.   Begin
  118.       glNewList(fGeneralLists+dlLightsOn,GL_COMPILE);
  119.          glEnable(GL_Lighting);
  120.          glLightModelfv(GL_LIGHT_MODEL_AMBIENT,@fGlobalAmbient);
  121.          If fLocalViewer then
  122.            glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER,1) else
  123.            glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER,0);
  124.          If fTwoSided then
  125.            glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,1) else
  126.            glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,0);
  127.          glEnable(GL_COLOR_MATERIAL);
  128.          glColorMaterial(GL_FRONT,GL_AMBIENT_AND_DIFFUSE);
  129.       glEndList;
  130.   end;
  131. (******* ******************************************************)
  132.  Procedure TCustomGLLightWindow.BuildDisplayLists;
  133.      Begin
  134.       If assigned(fShareGL) or not fStdDisplayList then exit;
  135.       Inherited ;
  136.       iF FGENERALlISTS=0 then exit;
  137.       // light model ON
  138.       BuilsLightSetUpList;
  139.  
  140.     // Light model OFF
  141.       glNewList(fGeneralLists+dlLightsOff,GL_COMPILE);
  142.        glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,0);
  143.        glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER,0);
  144.        glDisable(GL_COLOR_MATERIAL);
  145.        glDisable(GL_Lighting);
  146.       glEndList;
  147.     end;
  148. (*************************************************************)
  149.  Procedure TCustomGLLightWindow.SetheadLightOn(Value:Boolean);
  150.    //turn on and off the headlight
  151.   Begin
  152.      If fHeadLightState=Value then exit;
  153.      fHeadLightState:=Value;
  154.      EnableGL;
  155.      If fHeadLightState then LightOn(0) else LightOff(0);
  156.      Repaint;
  157.   end;
  158. (*************************************************************)
  159.    Procedure TCustomGLLightWindow.SetLightingState(Value:Boolean);
  160.    //turn omn lighting and set global values
  161.    Begin
  162.      If fLightingState=Value then exit;
  163.      fLightingState:=Value;
  164.      EnableGL;
  165.      If not fLightingState and fHeadLightState then SetHeadLightOn(False);
  166.      If fLightingState then
  167.         glCallList(fGeneralLists+dlLightsOn) else
  168.         glCallList(fGeneralLists+dlLightsOff);
  169.      Repaint;
  170.    end;
  171. (*************************************************************)
  172.  Procedure TCustomGLLightWindow.LightOn(aLightNum:SmallInt);
  173.    Begin
  174.      If (aLightNum>7)or (aLightNum<0) then exit;
  175.      If not fLightingState then SetLightingState(True);
  176.      fLights[aLightNum].TurnLightOn;
  177.    end;
  178. (*************************************************************)
  179.  Procedure TCustomGLLightWindow.LightOff(aLightNum:SmallInt);
  180.    Begin
  181.      If (aLightNum>7)or (aLightNum<0) then exit;
  182.      fLights[aLightNum].TurnLightOff;
  183.    end;
  184. (*************************************************************)
  185.  Function TCustomGLLightWindow.IsLightOn(aVal:SmallInt):Boolean;
  186.     //reuturn true if the specified light is on
  187.    Begin
  188.      Result:=False;
  189.      If (aVal>7)or (aVal<0) then exit;
  190.      Result:=fLights[aVal].IsOn;
  191.    end;
  192. (*************************************************************)
  193. (*************************************************************)
  194. (*procedure Register;
  195. begin
  196.   RegisterComponents('OpenGL', [TCustomGLLightWindow]);
  197. end;
  198.   *)
  199. end.
  200.